unit FMain;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.UITypes,
  System.Math,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Vcl.ExtCtrls,
  Vcl.Menus,
  Vcl.ComCtrls,
   
  GLS.VectorTypes,
  GLS.VectorTypesExt,
  GLS.PersistentClasses,
  GLS.Scene,
  GLS.SceneViewer,
  GLS.Objects,
  GLS.VectorFileObjects,
  GLS.VectorGeometry,
  GLS.State,
  GLS.Mesh,
  GLS.Color,
  GLS.Coordinates,
  
  GLS.BaseClasses,
  GLS.Spline,
  GLS.Material,
  GLS.Isosurface;

type
  TFrmMain = class(TForm)
    GLSceneViewer: TGLSceneViewer;
    Scene: TGLScene;
    Camera: TGLCamera;
    dcBox: TGLDummyCube;
    PUSerInterface: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    lblVertices: TLabel;
    lblTriangles: TLabel;
    rbgAlgorithm: TRadioGroup;
    ffObject: TGLFreeForm;
    MatLib: TGLMaterialLibrary;
    Light: TGLLightSource;
    rbgWireFrameFill: TRadioGroup;
    tbSize: TTrackBar;
    tbIsoValue: TTrackBar;
    Label3: TLabel;
    Label4: TLabel;
    rbgShading: TRadioGroup;
    TrackBar1: TTrackBar;
    Label5: TLabel;
    rbgInterpolation: TRadioGroup;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    OpenDialog: TOpenDialog;
    Help1: TMenuItem;
    SearchforHelpOn1: TMenuItem;
    About1: TMenuItem;
    N3: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure rbgAlgorithmClick(Sender: TObject);
    function MakeSphere(Rad: Integer; var ADataout: TArray3DExt;
      var Dims: array of word; CPt: array of Integer): Integer;
    procedure rbgInvertClick(Sender: TObject);
    procedure tbSizeChange(Sender: TObject);
    procedure rbgShadingClick(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure rbgWireFrameFillClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
  private
    ExtractedVertices: TVertexArray; // array of TVertex
    ExtractedTriangles: TIntegerArray; // array of Integer
    Dimensions: array ['x' .. 'z'] of Word;
    CenterPt: array ['x' .. 'z'] of Integer;
    CenterPts: array of array ['x' .. 'z'] of Integer;

    SingleData: TArray3DExt; // array of array of array of Single
    mdx, mdy: Integer;
    procedure GeneratePositions;
    procedure FillBlock;
        // Load Data from file
    function LoadCharData(AFileName: String; out ADataout: TArray3DExt;
      var Dims: array of word): Integer;

  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  SingleData := nil;
  GeneratePositions;
  FillBlock;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  SetLength(SingleData, 0, 0, 0);
end;

procedure TFrmMain.rbgInvertClick(Sender: TObject);
begin
  FillBlock;
end;

procedure TFrmMain.GeneratePositions;
var
  DataAmount: Cardinal;
  i: Integer;
  X, Y, z: Integer;
begin
  // don't redraw when the trackbar is exited, already drawn when it was moved
  if TrackBar1.Position = Length(CenterPts) then
    Exit;

  Dimensions['x'] := tbSize.Position;
  Dimensions['y'] := tbSize.Position;
  Dimensions['z'] := tbSize.Position;

  SetLength(CenterPts, TrackBar1.Position);
  if TrackBar1.Position = 1 then
  begin
    CenterPts[0, 'x'] := 50;
    CenterPts[0, 'y'] := 50;
    CenterPts[0, 'z'] := 50;
  end
  else
    for i := 0 to TrackBar1.Position - 1 do
    begin
      CenterPts[i, 'x'] := Random(100);
      CenterPts[i, 'y'] := Random(100);
      CenterPts[i, 'z'] := Random(100);
    end;
end;

procedure TFrmMain.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.FillBlock;
var
  DataAmount: cardinal;
  i: Integer;
  X, Y, Z: Integer;
begin
  Dimensions['x'] := tbSize.Position;
  Dimensions['y'] := tbSize.Position;
  Dimensions['z'] := tbSize.Position;
  SetLength(SingleData, 0, 0, 0);
  SetLength(SingleData, tbSize.Position, tbSize.Position, tbSize.Position);
  for i := 0 to TrackBar1.Position - 1 do
  begin
    CenterPt['x'] := round(CenterPts[i, 'x'] / 100 * tbSize.Position);
    CenterPt['y'] := round(CenterPts[i, 'y'] / 100 * tbSize.Position);
    CenterPt['z'] := round(CenterPts[i, 'z'] / 100 * tbSize.Position);
    MakeSphere(round(tbSize.Position / 2.5), SingleData, Dimensions, CenterPt);
  end;
  rbgAlgorithmClick(Self);
end;

// MakeSphere --------------------------------------------------------
function TFrmMain.MakeSphere(Rad: Integer; var ADataout: TArray3DExt;
  var Dims: array of word; CPt: array of Integer): Integer;
var
  X, Y, Z: Integer;
  DataPoint: Byte;
  Counter: Integer;
  v: single;
begin
  // SetLength(ADataout, Dims[0], Dims[1], Dims[2]);
  Counter := 0;

  for X := -Rad to Rad do
    for Y := -Rad to Rad do
      for Z := -Rad to Rad do
      begin
        v := Sin(DegToRad(((X + Rad) / (2 * Rad)) * 180)) *
          Sin(DegToRad(((Y + Rad) / (2 * Rad)) * 180)) *
          Sin(DegToRad(((Z + Rad) / (2 * Rad)) * 180));
        if (v > 0) and ((X + CPt[0]) >= 0) and ((X + CPt[0]) <= high(ADataout))
          and ((Y + CPt[1]) >= 0) and ((Y + CPt[1]) <= high(ADataout[0])) and
          ((z + CPt[2]) >= 0) and ((z + CPt[2]) <= high(ADataout[0, 0])) and
          (ADataout[X + CPt[0], Y + CPt[1], z + CPt[2]] < v * 255) then
          ADataout[X + CPt[0], Y + CPt[1], z + CPt[2]] := v * 255;
        inc(Counter);
      end;

  Result := Counter;
end;

procedure TFrmMain.Open1Click(Sender: TObject);
var
  DataAmount: Cardinal;

begin
  Dimensions['x'] := 27;  // only for Cube.vol sample
  Dimensions['y'] := 27;
  Dimensions['z'] := 27;

  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  OpenDialog.Filter := 'Volumes|*.vol';
  if OpenDialog.Execute() then
  begin
    DataAmount := LoadCharData(OpenDialog.FileName, SingleData, Dimensions);
    MessageDlg(format('%d read. %dx%dx%d', [DataAmount, Dimensions['x'],
      Dimensions['y'], Dimensions['z']]), mtInformation, [mbOK], -1);
  end;
  rbgAlgorithmClick(Self);
end;

procedure TFrmMain.rbgAlgorithmClick(Sender: TObject);
var
  IsoSurfaceEx: TGLIsoSurfaceExtractor;
  i: Integer;
  mo: TGLMeshObject;
begin
  // Create IsoSurfaceExtractor
  IsoSurfaceEx := TGLIsoSurfaceExtractor.Create(Dimensions['x'], Dimensions['y'],
    Dimensions['z'], SingleData);
  // Launch Calculation
  case rbgAlgorithm.ItemIndex of
    0:
      IsoSurfaceEx.MarchingTetrahedra(tbIsoValue.Position, ExtractedVertices,
        ExtractedTriangles, rbgInterpolation.ItemIndex.ToBoolean);
    1:
      IsoSurfaceEx.MarchingCubes(tbIsoValue.Position, ExtractedVertices,
        ExtractedTriangles, rbgInterpolation.ItemIndex.ToBoolean);
  end;

  lblVertices.Caption := Format('%d', [length(ExtractedVertices)]);
  lblTriangles.Caption := Format('%d', [length(ExtractedTriangles) div 3]);
  IsoSurfaceEx.Free();

  ffObject.MaterialLibrary := MatLib;

  ffObject.MeshObjects.Clear();
  mo := TGLMeshObject.CreateOwned(ffObject.MeshObjects);
  for i := length(ExtractedTriangles) - 1 downto 0 do
    with ExtractedVertices[ExtractedTriangles[i]] do
      mo.Vertices.Add(AffineVectorMake(X - Dimensions['x'] / 2,
        Y - Dimensions['y'] / 2, z - Dimensions['z'] / 2));

  ffObject.StructureChanged;
  rbgWireFrameFillClick(nil);
end;

procedure TFrmMain.tbSizeChange(Sender: TObject);
begin
  FillBlock;
end;

procedure TFrmMain.TrackBar1Change(Sender: TObject);
begin
  GeneratePositions;
  FillBlock;
end;


procedure TFrmMain.rbgShadingClick(Sender: TObject);
begin
  if rbgShading.ItemIndex = 0 then
    GLSceneViewer.Buffer.ShadeModel := smFlat
  else
    GLSceneViewer.Buffer.ShadeModel := smSmooth;
end;

procedure TFrmMain.rbgWireFrameFillClick(Sender: TObject);
begin
  if rbgWireFrameFill.ItemIndex = 0 then
    ffObject.Material.PolygonMode := pmFill
  else
    ffObject.Material.PolygonMode := pmLines;
  GLSceneViewer.Invalidate();
end;

procedure TFrmMain.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  Camera.AdjustDistanceToTarget(Power(1.1, WheelDelta / 120));
end;

procedure TFrmMain.GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  mdx := X;
  mdy := Y;
end;

procedure TFrmMain.GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  dx, dy: Integer;
  v: TGLVector;
begin
  // calculate delta since last move or last mousedown
  dx := mdx - X;
  dy := mdy - Y;
  mdx := X;
  mdy := Y;
  if ssLeft in Shift then
  begin
    if ssShift in Shift then
    begin
      // right button with shift rotates the teapot
      // (rotation happens around camera's axis)
      Camera.RotateObject(dcBox, dy, dx);
    end
    else
    begin
      // right button without shift changes camera angle
      // (we're moving around the parent and target dummycube)
      Camera.MoveAroundTarget(dy, dx)
    end;
  end
  else if Shift = [ssRight] then
  begin
    // left button moves our target and parent dummycube
    v := Camera.ScreenDeltaToVectorXY(dx, -dy,
      0.12 * Camera.DistanceToTarget / Camera.FocalLength);
    dcBox.Position.Translate(v);
    // notify camera that its position/target has been changed
    Camera.TransformationChanged;
  end;
end;

// LoadCharData --------------------------------------------------------------
function TFrmMain.LoadCharData(aFileName: String; out aDataout: TArray3DExt;
  var Dims: array of word): Integer;

var
  DataFile: File of Byte;
  i, j, k: Integer;
  DataPoint: Byte;
  Counter: Integer;

begin
  AssignFile(DataFile, aFileName);
  Reset(DataFile);
  SetLength(aDataout, Dims[0], Dims[1], Dims[2]);
  i := 0;
  j := 0;
  k := 0;
  Counter := 0;
  try
    repeat
      Read(DataFile, DataPoint);
      aDataout[i, j, k] := DataPoint;
      inc(i);
      if (i = Dims[0]) then
      begin
        i := 0;
        inc(j);
      end;
      if (j = Dims[1]) then
      begin
        j := 0;
        inc(k);
      end;
      inc(Counter);
    until Eof(DataFile);
  finally
    Closefile(DataFile);
  end;
  Result := Counter;
end;

end.
